﻿
'=====================================================================
'模 块 名：mdlReport

'描    述：报表输出操作模块

'依赖模块：EPPlus

'使用方法：(1)TestReportUpdate() 读取模板数据库
'          (2)TestReportPrint() 打印文件

'原始版本：1.00
'作    者：费鸣杰
'完成日期：2021-08-12

'修改版本：
'修改作者：
'修改日期：
'修改记录：
'          
'=====================================================================
Imports System.Data
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions

Namespace FL_8x0.Common

    Module mdlReport

        Public dtRecordTemplates As New DataTable       '测试记录模板数据集合
        Public dtCurRecordTempl As New DataTable        '当前使用的测试记录模板
        Public strCurRecordSheet As String = Nothing    '当前使用的测试记录模板Sheet名称

        Dim MyExcel As EPPlus = New EPPlus



        '=====================================================================
        '函 数 名: TestReportUpdate
        '参    数: strCurTempl  = 当前使用的模板名称
        '返 回 值: 错误号
        '功能描述: 测试记录 从数据库读取测试记录模板
        '          当"模板管理.mdb"数据库更新后，需要调用此函数
        '=====================================================================
        Public Function TestReportUpdate(strCurTempl As String) As Boolean
            Dim bIsOK As Boolean = False

            If (True = Template_ReadRecordTemplate(dtRecordTemplates)) Then
                If Not IsNothing(dtRecordTemplates) And dtRecordTemplates.Rows.Count > 0 Then
                    Dim i As Int32
                    For i = 0 To dtRecordTemplates.Rows.Count - 1
                        If dtRecordTemplates.Rows.Item(i).Item("模板名称") = strCurTempl Then

                            dtCurRecordTempl.Rows.Clear()
                            dtCurRecordTempl = dtRecordTemplates.Clone()
                            dtCurRecordTempl.ImportRow(dtRecordTemplates.Rows.Item(i))

                            strCurRecordSheet = dtRecordTemplates.Rows.Item(i).Item("Sheet名称")

                            bIsOK = True
                        End If
                    Next i
                End If
            End If

            Return bIsOK
        End Function


        '=====================================================================
        '函 数 名: TestReportPrint
        '参    数: strSrcTemplFile   = 原始模板文件路径(如 C:\Excel模版.xlsx)
        '          strDestTemplDir   = 目的模板文件夹(如 C:\TestRecord\)
        '          dtTestRecord      = 测试记录表
        '          strPrinterName    = 使用的打印机名称
        '返 回 值: 是否成功
        '          True     = 成功
        '          False    = 失败
        '功能描述: 测试记录 打印
        '=====================================================================
        Public Function TestReportPrint(strSrcTemplFile As String, strDestTemplDir As String, dtTestRecord As DataTable, strPrinterName As String) As Boolean
            Dim bIsOK As Boolean = True
            Dim strFile As String

            Try
                strFile = strDestTemplDir
                If Not strFile.EndsWith("\") Then
                    strFile &= "\"
                End If

                If Directory.Exists(strFile) = False Then   '如果文件夹不存在
                    Directory.CreateDirectory(strFile)
                End If

                strFile = strSrcTemplFile
                Dim fFile As IO.FileInfo = New IO.FileInfo(strFile)
                fFile = New FileInfo(strFile)
                If fFile.Exists Then

                    Dim strName As String
                    Dim strExt As String
                    strName = Path.GetFileNameWithoutExtension(strSrcTemplFile)
                    strName &= "_tmp"
                    strExt = Path.GetExtension(strSrcTemplFile)

                    '另存为带宏的Excel文件
                    If True Then
                        strExt = ".xlsm"
                    End If

                    strName &= strExt
                    strFile = Path.GetDirectoryName(strDestTemplDir) & "\" & strName

                    fFile.CopyTo(strFile, True)
                    fFile = New FileInfo(strFile)

                    If fFile.Exists Then
                        TestReportSave(strFile, dtTestRecord)
                        mdlPrinter.PrintFile(strFile, strPrinterName, 0)
                    End If
                Else    '如果模板文件不存在

                End If

            Catch ex As Exception
                log.WriteLogError("TestReportPrint():" & strSrcTemplFile & strDestTemplDir, ex.Message)
            End Try

            Return bIsOK
        End Function


        '=====================================================================
        '函 数 名: _FindCellStr
        '参    数: iRow               = 行号
        '          strCol             = 列名称字符串
        '          dtTable            = 要查找的数据表
        '返 回 值: 找到的字符串值
        '功能描述: 查找并返回数据表中对应行、列的字符串的值
        '=====================================================================
        Private Function _FindCellStr(iRow As Integer, strCol As String, dtTable As DataTable) As String
            If iRow >= 0 And iRow < dtTable.Rows.Count Then
                Return dtTable.Rows(iRow).Item(strCol)
            End If
            Return Nothing
        End Function


        '=====================================================================
        '函 数 名: _CellStrAdd
        '参    数: strCell            = 单元格字符串，如"A1"
        '          iAdd               = 增加的整数值
        '          strDataType        = 返回数据类型
        '返 回 值: 增加后的单元格字符串
        '功能描述: 单元格增加整型数值
        '=====================================================================
        Private Function _CellStrAdd(strCell As String, iAdd As Int32, ByRef strDataType As String) As String
            Dim strChar As String = Nothing
            Dim strNum As String = Nothing

            Dim reg As New Regex("[A-Z,a-z]+")
            Dim m As Match = reg.Match(strCell)
            m = reg.Match(strCell)
            If m.Success Then
                strChar = m.Value
            End If

            reg = New Regex("\d+")
            m = reg.Match(strCell)
            If m.Success Then
                strNum = m.Value
            End If

            reg = New Regex(",[A-Z,a-z]+")
            m = reg.Match(strCell)
            If m.Success Then
                strDataType = m.Value
            End If

            If Not IsNothing(strNum) Then
                Dim itmp = CInt(strNum)
                itmp += iAdd
                strNum = CStr(itmp)
            End If

            If Not IsNothing(strChar) And Not IsNothing(strNum) Then
                Return strChar & strNum
            Else
                Return Nothing
            End If

            Return Nothing
        End Function


        '=====================================================================
        '函 数 名: TestReportSave
        '参    数: strFileName       = 文件路径(如 C:\TestRecord\Excel模版_tmp.xlsm)
        '返 回 值: 是否成功
        '          True     = 成功
        '          False    = 失败
        '功能描述: 测试记录 保存
        '=====================================================================
        Public Function TestReportSave(strFileName As String, dtTestRecord As DataTable) As Boolean
            Dim bIsOK As Boolean = False
            Dim iDataRow As Int32 = 0       '测试数据行号

            If IsNothing(dtRecordTemplates) Or IsNothing(dtCurRecordTempl) Or IsNothing(strCurRecordSheet) Then  '测试记录模板数据集
                Return False
            End If

            If dtTestRecord.Rows.Count < 1 Then
                Return False
            End If

            Try
                '打开Excel文件
                'Dim MyExcel As EPPlus = New EPPlus
                If (EPPlus.EPPLUS_ERR_OK = MyExcel.OpenExcel(strFileName)) Then
                    '写入Excel文件
                    Dim strSheet As String = strCurRecordSheet  '模板Sheet名称
                    Dim strCell As String = Nothing     '模板单元格地址("A1")
                    Dim strValue As String = Nothing    '测试记录表中的数据
                    Dim strType As String = Nothing     '测试记录表中的数据类型
                    Dim strName As String = Nothing     '表列名称
                    Dim iRow As Int32 = 0
                    Dim strReportID As String = Nothing
                    Dim strTestRep As String = Nothing

                    iDataRow = 0
                    For iRow = 0 To dtTestRecord.Rows.Count - 1
                        If iRow = 0 Then
                            strReportID = _FindCellStr(iRow, "报告号", dtTestRecord)
                        End If

                        strTestRep = _FindCellStr(iRow, "报告号", dtTestRecord)
                        If (strReportID = _FindCellStr(iRow, "报告号", dtTestRecord)) Then
                            For Each column As DataColumn In dtTestRecord.Columns
                                strName = column.ColumnName.ToString
                                strCell = _FindCellStr(0, strName, dtCurRecordTempl)
                                strValue = _FindCellStr(iRow, strName, dtTestRecord)
                                strType = ""

                                If InStr(strCell, ",") > 0 Then
                                    Dim tmp() As String = Split(strCell, ",")
                                    strCell = Trim(tmp(0))
                                    strType = Trim(tmp(1))
                                Else
                                    strCell = Trim(strCell)
                                    strType = ""
                                End If

                                If Left(strCell, 1) = "@" Then  '如果是按行递增
                                    strCell = _CellStrAdd(strCell, iDataRow, strType)
                                Else
                                    strCell = _CellStrAdd(strCell, 0, strType)
                                End If

                                If strType <> "" Then
                                    If strType = "I" Or strType = "i" Then '如果是整型
                                        MyExcel.WriteExcel(strSheet, strCell, CLng(strValue))
                                    ElseIf strType = "S" Or strType = "s" Then '如果是浮点型
                                        MyExcel.WriteExcel(strSheet, strCell, CSng(strValue))
                                    Else    '如果是文本型
                                        MyExcel.WriteExcel(strSheet, strCell, strValue)
                                    End If
                                Else    '如果是文本型
                                    MyExcel.WriteExcel(strSheet, strCell, strValue)
                                End If
                            Next

                            iDataRow += 1
                        End If
                    Next

                    '写入VBA代码
                    If InStr(Path.GetExtension(strFileName), "xlsm") Then
                        Dim sb As New StringBuilder
                        sb.AppendLine("Sub Workbook_BeforeClose(Cancel As Boolean)")
                        sb.AppendLine("    Application.DisplayAlerts = False")
                        sb.AppendLine("    ThisWorkbook.Close savechanges:=False")
                        'sb.AppendLine("    Workbooks.Close")
                        'sb.AppendLine("    ActiveWorkbook.Close")

                        'sb.AppendLine("    Application.DisplayAlerts = True")
                        sb.AppendLine("    Application.Quit")
                        sb.AppendLine("End Sub")
                        MyExcel.WriteVBA(Nothing, sb.ToString)
                    End If

                    '保存Excel文件
                    MyExcel.SaveExcel(Nothing)  '保存到当前文件中
                End If

            Catch ex As Exception
                log.WriteLogError("TestReportSave():" & strFileName, ex.Message)
            End Try

            Return bIsOK
        End Function



    End Module
End Namespace